home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / lib / xt / callback.c < prev    next >
C/C++ Source or Header  |  1992-10-09  |  4KB  |  129 lines
  1. #include "xt.h"
  2.  
  3. typedef struct {
  4.     PFX2S converter;
  5.     int num;
  6. } CLIENT_DATA;
  7.  
  8. Object Get_Callbackfun (c) XtPointer c; {
  9.     register CLIENT_DATA *cd = (CLIENT_DATA *)c;
  10.     return cd ? Get_Function (cd->num) : False;
  11. }
  12.  
  13. static void Callback_Proc (w, client_data, call_data) Widget w;
  14.     XtPointer client_data, call_data; {
  15.     register CLIENT_DATA *cd = (CLIENT_DATA *)client_data;
  16.     Object args = Null;
  17.     GC_Node;
  18.  
  19.     GC_Link (args);
  20.     if (cd->converter)
  21.     args = Cons ((cd->converter)((XtArgVal)call_data), args);
  22.     args = Cons (Make_Widget_Foreign (w), args);
  23.     GC_Unlink;
  24.     (void)Funcall (Get_Callbackfun (client_data), args, 0);
  25. }
  26.  
  27. /*ARGSUSED*/
  28. void Destroy_Callback_Proc (w, client_data, call_data) Widget w;
  29.     XtPointer client_data, call_data; {
  30.     Object x;
  31.  
  32.     x = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w);
  33.     if (Nullp (x) || WIDGET(x)->free)
  34.     return;
  35.     WIDGET(x)->free = 1;
  36.     Remove_All_Callbacks (w);
  37.     Deregister_Object (x);
  38. }
  39.  
  40. /* The code assumes that callbacks are called in the order they
  41.  * have been added.  The Destroy_Callback_Proc() must always be
  42.  * the last callback in the destroy callback list of each widget.
  43.  *
  44.  * When the destroy callback list of a widget is modified
  45.  * (via P_Add_Callbacks or P_Set_Values), Fiddle_Destroy_Callback()
  46.  * must be called to remove the Destroy_Callback_Proc() and put
  47.  * it back to the end of the callback list.
  48.  */
  49. void Fiddle_Destroy_Callback (w) Widget w; {
  50.     XtRemoveCallback (w, XtNdestroyCallback, Destroy_Callback_Proc,
  51.     (XtPointer)0);
  52.     XtAddCallback (w, XtNdestroyCallback, Destroy_Callback_Proc, (XtPointer)0);
  53. }
  54.  
  55. void Check_Callback_List (x) Object x; {
  56.     Object tail;
  57.  
  58.     Check_List (x);
  59.     for (tail = x; !Nullp (tail); tail = Cdr (tail))
  60.     Check_Procedure (Car (tail));
  61. }
  62.  
  63. static Object P_Add_Callbacks (w, name, cbl) Object w, name, cbl; {
  64.     register char *s;
  65.     register n;
  66.     XtCallbackList callbacks;
  67.     Declare_C_Strings;
  68.  
  69.     Check_Widget (w);
  70.     Check_Callback_List (cbl);
  71.     Make_C_String (name, s);
  72.     Make_Resource_Name (s);
  73.     n = Fast_Length (cbl);
  74.     Alloca (callbacks, XtCallbackRec*, (n+1) * sizeof (XtCallbackRec));
  75.     callbacks[n].callback = 0;
  76.     callbacks[n].closure = 0;
  77.     Fill_Callbacks (cbl, callbacks, n,
  78.     Find_Callback_Converter (XtClass (WIDGET(w)->widget), s, name));
  79.     XtAddCallbacks (WIDGET(w)->widget, s, callbacks);
  80.     if (streq (s, XtNdestroyCallback))
  81.     Fiddle_Destroy_Callback (WIDGET(w)->widget);
  82.     Dispose_C_Strings;
  83.     return Void;
  84. }
  85.  
  86. void Fill_Callbacks (src, dst, n, conv) Object src; XtCallbackList dst;
  87.     register n; PFX2S conv; {
  88.     register CLIENT_DATA *cd;
  89.     register i, j;
  90.     Object tail;
  91.  
  92.     for (i = 0, tail = src; i < n; i++, tail = Cdr (tail)) {
  93.     j = Register_Function (Car (tail));
  94.     cd = (CLIENT_DATA *)XtMalloc (sizeof (CLIENT_DATA));
  95.     cd->converter = conv;
  96.     cd->num = j;
  97.     dst[i].callback = (XtCallbackProc)Callback_Proc;
  98.     dst[i].closure = (XtPointer)cd;
  99.     }
  100. }
  101.  
  102. Remove_All_Callbacks (w) Widget w; {
  103.     Arg a[1];
  104.     XtCallbackList c;
  105.     XtResource *r;
  106.     int nr, nc;
  107.     register i, j;
  108.  
  109.     Get_All_Resources (0, w, XtClass (w), &r, &nr, &nc);
  110.     for (j = 0; j < nr; j++) {
  111.     if (streq (r[j].resource_type, XtRCallback)) {
  112.         XtSetArg (a[0], r[j].resource_name, &c);
  113.         XtGetValues (w, a, 1);
  114.         for (i = 0; c[i].callback; i++) {
  115.         register CLIENT_DATA *cd = (CLIENT_DATA *)c[i].closure;
  116.         if (c[i].callback == (XtCallbackProc)Callback_Proc && cd) {
  117.             Deregister_Function (cd->num);
  118.             XtFree ((char *)cd);
  119.         }
  120.         }
  121.     }
  122.     }
  123.     XtFree ((char *)r);
  124. }
  125.  
  126. init_xt_callback () {
  127.     Define_Primitive (P_Add_Callbacks, "add-callbacks", 3, 3, EVAL);
  128. }
  129.